home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / goonix / posix.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-02  |  22.3 KB  |  1,051 lines
  1. /*    Copyright (C) 1995 Free Software Foundation, Inc.
  2.  * 
  3.  * This program is free software; you can redistribute it and/or modify
  4.  * it under the terms of the GNU General Public License as published by
  5.  * the Free Software Foundation; either version 2, or (at your option)
  6.  * any later version.
  7.  * 
  8.  * This program is distributed in the hope that it will be useful,
  9.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  * GNU General Public License for more details.
  12.  * 
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with this software; see the file COPYING.  If not, write to
  15.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  *
  17.  * As a special exception, the Free Software Foundation gives permission
  18.  * for additional uses of the text contained in its release of GUILE.
  19.  *
  20.  * The exception is that, if you link the GUILE library with other files
  21.  * to produce an executable, this does not by itself cause the
  22.  * resulting executable to be covered by the GNU General Public License.
  23.  * Your use of that executable is in no way restricted on account of
  24.  * linking the GUILE library code into it.
  25.  *
  26.  * This exception does not however invalidate any other reasons why
  27.  * the executable file might be covered by the GNU General Public License.
  28.  *
  29.  * This exception applies only to the code released by the
  30.  * Free Software Foundation under the name GUILE.  If you copy
  31.  * code from other Free Software Foundation releases into a copy of
  32.  * GUILE, as the General Public License permits, the exception does
  33.  * not apply to the code that you add in this way.  To avoid misleading
  34.  * anyone as to the status of such modified files, you must delete
  35.  * this exception notice from them.
  36.  *
  37.  * If you write modifications of your own for GUILE, it is your choice
  38.  * whether to permit this exception to apply to your modifications.
  39.  * If you do not wish that, delete this exception notice.  
  40.  */
  41.  
  42.  
  43. #include <stdio.h>
  44. #include "_scm.h"
  45.  
  46.  
  47.  
  48. #if TIME_WITH_SYS_TIME
  49. # include <sys/time.h>
  50. # include <time.h>
  51. #else
  52. # if HAVE_SYS_TIME_H
  53. #  include <sys/time.h>
  54. # else
  55. #  include <time.h>
  56. # endif
  57. #endif
  58.  
  59. #ifdef HAVE_SYS_SELECT_H
  60. #include <sys/select.h>
  61. #endif
  62.  
  63. #include <sys/stat.h>
  64.  
  65.  
  66. #include <pwd.h>
  67.  
  68. #include <sys/types.h>
  69. #if HAVE_SYS_WAIT_H
  70. # include <sys/wait.h>
  71. #endif
  72. #ifndef WEXITSTATUS
  73. # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
  74. #endif
  75. #ifndef WIFEXITED
  76. # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
  77. #endif
  78.  
  79. #include <signal.h>
  80.  
  81. #ifdef FD_SET
  82.  
  83. #define SELECT_TYPE fd_set
  84. #define SELECT_SET_SIZE FD_SETSIZE
  85.  
  86. #else /* no FD_SET */
  87.  
  88. /* Define the macros to access a single-int bitmap of descriptors.  */
  89. #define SELECT_SET_SIZE 32
  90. #define SELECT_TYPE int
  91. #define FD_SET(n, p) (*(p) |= (1 << (n)))
  92. #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
  93. #define FD_ISSET(n, p) (*(p) & (1 << (n)))
  94. #define FD_ZERO(p) (*(p) = 0)
  95.  
  96. #endif /* no FD_SET */
  97.  
  98.  
  99. extern char *ttyname ();
  100. extern FILE *popen ();
  101.  
  102. #include <grp.h>
  103. #include <sys/utsname.h>
  104.  
  105.  
  106.  /* Only the superuser can successfully execute this call */
  107. PROC (s_sys_chown, "%chown", 3, 0, 0, scm_sys_chown);
  108. #ifdef __STDC__
  109. SCM 
  110. scm_sys_chown (SCM path, SCM owner, SCM group)
  111. #else
  112. SCM 
  113. scm_sys_chown (path, owner, group)
  114.      SCM path;
  115.      SCM owner;
  116.      SCM group;
  117. #endif
  118. {
  119.   int val;
  120.   ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_sys_chown);
  121.   ASSERT (INUMP (owner), owner, ARG2, s_sys_chown);
  122.   ASSERT (INUMP (group), group, ARG3, s_sys_chown);
  123.   SYSCALL (val = chown (CHARS (path), INUM (owner), INUM (group)));
  124.   return val ? BOOL_F : BOOL_T;
  125. }
  126.  
  127.  
  128. PROC (s_sys_link, "%link", 2, 0, 0, scm_sys_link);
  129. #ifdef __STDC__
  130. SCM 
  131. scm_sys_link (SCM oldpath, SCM newpath)
  132. #else
  133. SCM 
  134. scm_sys_link (oldpath, newpath)
  135.      SCM oldpath;
  136.      SCM newpath;
  137. #endif
  138. {
  139.   int val;
  140.   ASSERT (NIMP (oldpath) && STRINGP (oldpath), oldpath, ARG1, s_sys_link);
  141.   ASSERT (NIMP (newpath) && STRINGP (newpath), newpath, ARG2, s_sys_link);
  142.   SYSCALL (val = link (CHARS (oldpath), CHARS (newpath)));
  143.   return val ? BOOL_F : BOOL_T;
  144. }
  145.  
  146.  
  147. PROC (s_sys_pipe, "%pipe", 0, 0, 0, scm_sys_pipe);
  148. #ifdef __STDC__
  149. SCM 
  150. scm_sys_pipe (void)
  151. #else
  152. SCM 
  153. scm_sys_pipe ()
  154. #endif
  155. {
  156.   int fd[2], rv;
  157.   FILE *f_rd, *f_wt;
  158.   SCM p_rd, p_wt;
  159.   NEWCELL (p_rd);
  160.   NEWCELL (p_wt);
  161.   rv = pipe (fd);
  162.   if (rv)
  163.     {
  164.       ALLOW_INTS;
  165.       return BOOL_F;
  166.     }
  167.   f_rd = fdopen (fd[0], "r");
  168.   if (!f_rd)
  169.     {
  170.       SYSCALL (close (fd[0]));
  171.       SYSCALL (close (fd[1]));
  172.       ALLOW_INTS;
  173.       return BOOL_F;
  174.     }
  175.   f_wt = fdopen (fd[1], "w");
  176.   if (!f_wt)
  177.     {
  178.       fclose (f_rd);
  179.       SYSCALL (close (fd[1]));
  180.       ALLOW_INTS;
  181.       return BOOL_F;
  182.     }
  183.   CAR (p_rd) = tc16_fport | scm_mode_bits ("r");
  184.   CAR (p_wt) = tc16_fport | scm_mode_bits ("w");
  185.   SETSTREAM (p_rd, f_rd);
  186.   SETSTREAM (p_wt, f_wt);
  187.   scm_add_to_port_table (p_rd);
  188.   scm_add_to_port_table (p_wt);
  189.   ALLOW_INTS;
  190.   return scm_cons (p_rd, p_wt);
  191. }
  192.  
  193.  
  194. /* FIXME: pipe streams are not currently added to the scm_list of ports.
  195.  * If pipe streams are to be kept then some things need to be changed.
  196.  * open-pipe should also be given a exception wrapper.
  197.  */
  198. PROC (s_open_pipe, "open-pipe", 2, 0, 0, scm_open_pipe);
  199. #ifdef __STDC__
  200. SCM 
  201. scm_open_pipe (SCM pipestr, SCM modes)
  202. #else
  203. SCM 
  204. scm_open_pipe (pipestr, modes)
  205.      SCM pipestr;
  206.      SCM modes;
  207. #endif
  208. {
  209.   FILE *f;
  210.   register SCM z;
  211.   ASSERT (NIMP (pipestr) && STRINGP (pipestr), pipestr, ARG1, s_open_pipe);
  212.   ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_open_pipe);
  213.   NEWCELL (z);
  214.   /* DEFER_INTS, SYSCALL, and ALLOW_INTS are probably paranoid here*/
  215.   DEFER_INTS;
  216.   scm_ignore_signals ();
  217.   SYSCALL (f = popen (CHARS (pipestr), CHARS (modes)));
  218.   scm_unignore_signals ();
  219.   if (!f)
  220.     z = BOOL_F;
  221.   else
  222.     {
  223.       CAR (z) = tc16_pipe | OPN | (strchr (CHARS (modes), 'r') ? RDNG : WRTNG);
  224.       SETSTREAM (z, f);
  225.     }
  226.   ALLOW_INTS;
  227.   return z;
  228. }
  229.  
  230.  
  231. PROC (s_open_input_pipe, "open-input-pipe", 1, 0, 0, scm_open_input_pipe);
  232. #ifdef __STDC__
  233. SCM
  234. scm_open_input_pipe(SCM pipestr)
  235. #else
  236. SCM
  237. scm_open_input_pipe(pipestr)
  238.      SCM pipestr;
  239. #endif
  240. {
  241.   return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
  242. }
  243.  
  244. PROC (s_open_output_pipe, "open-output-pipe", 1, 0, 0, scm_open_output_pipe);
  245. #ifdef __STDC__
  246. SCM
  247. scm_open_output_pipe(SCM pipestr)
  248. #else
  249. SCM
  250. scm_open_output_pipe(pipestr)
  251.      SCM pipestr;
  252. #endif
  253. {
  254.   return scm_open_pipe(pipestr, scm_makfromstr("w", (sizeof "w")-1, 0));
  255. }
  256.  
  257.  
  258. #ifdef __STDC__
  259. static int
  260. prinpipe(SCM exp, SCM port, int writing)
  261. #else
  262. static int
  263. prinpipe(exp, port, writing)
  264.      SCM exp;
  265.      SCM port;
  266.      int writing;
  267. #endif
  268. {
  269.   scm_prinport(exp, port, s_open_output_pipe);
  270.   return !0;
  271. }
  272.  
  273.  
  274.  
  275. PROC (s_sys_getgroups, "%getgroups", 0, 0, 0, scm_sys_getgroups);
  276. #ifdef __STDC__
  277. SCM
  278. scm_sys_getgroups(void)
  279. #else
  280. SCM
  281. scm_sys_getgroups()
  282. #endif
  283. {
  284.   SCM grps, ans;
  285.   int ngroups = getgroups (0, NULL);
  286.   if (!ngroups) return BOOL_F;
  287.   NEWCELL(grps);
  288.   DEFER_INTS;
  289.   {
  290.     GETGROUPS_T *groups = (gid_t *)scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
  291.                          s_sys_getgroups);
  292.     int val = getgroups(ngroups, groups);
  293.     if (val < 0) {
  294.       scm_must_free((char *)groups);
  295.       ALLOW_INTS;
  296.       return BOOL_F;
  297.     }
  298.     SETCHARS(grps, groups);    /* set up grps as a GC protect */
  299.     SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), tc7_string);
  300.     ALLOW_INTS;
  301.     ans = scm_make_vector(MAKINUM(ngroups), SCM_UNDEFINED);
  302.     while (--ngroups >= 0) VELTS(ans)[ngroups] = MAKINUM(groups[ngroups]);
  303.     SETCHARS(grps, groups);    /* to make sure grps stays around. */
  304.     return ans;
  305.   }
  306. }  
  307.  
  308. /* These 2 routines are not protected against `entry' being reused
  309.  * before access to that structure is completed
  310.  */
  311.  
  312. PROC (s_sys_getpwuid, "%getpwuid", 0, 1, 0, scm_sys_getpwuid);
  313. #ifdef __STDC__
  314. SCM 
  315. scm_sys_getpwuid (SCM user)
  316. #else
  317. SCM 
  318. scm_sys_getpwuid (user)
  319.      SCM user;
  320. #endif
  321. {
  322.   SCM result;
  323.   struct passwd *entry;
  324.   SCM *ve;
  325.  
  326.   result = scm_make_vector (MAKINUM (7), UNSPECIFIED);
  327.   ve = VELTS (result);
  328.   if (UNBNDP (user) || FALSEP (user))
  329.     SYSCALL (entry = getpwent ());
  330.   else if (INUMP (user))
  331.     entry = getpwuid (INUM (user));
  332.   else
  333.     {
  334.       ASSERT (NIMP (user) && STRINGP (user), user, ARG1, s_sys_getpwuid);
  335.       entry = getpwnam (CHARS (user));
  336.     }
  337.   if (!entry)
  338.     return BOOL_F;
  339.   ve[0] = makfrom0str (entry->pw_name);
  340.   ve[1] = makfrom0str (entry->pw_passwd);
  341.   ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
  342.   ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
  343.   ve[4] = makfrom0str (entry->pw_gecos);
  344.   if (!entry->pw_dir)
  345.     ve[5] = makfrom0str ("");
  346.   else
  347.     ve[5] = makfrom0str (entry->pw_dir);
  348.   if (!entry->pw_shell)
  349.     ve[6] = makfrom0str ("");
  350.   else
  351.     ve[6] = makfrom0str (entry->pw_shell);
  352.   return result;
  353. }
  354.  
  355.  
  356. PROC (s_setpwent, "setpwent", 0, 1, 0, scm_setpwent);
  357. #ifdef __STDC__
  358. SCM 
  359. scm_setpwent (SCM arg)
  360. #else
  361. SCM 
  362. scm_setpwent (arg)
  363.      SCM arg;
  364. #endif
  365. {
  366.   if (UNBNDP (arg) || FALSEP (arg))
  367.     endpwent ();
  368.   else
  369.     setpwent ();
  370.   return UNSPECIFIED;
  371. }
  372.  
  373.  
  374. /* Combines getgrgid and getgrnam.  */
  375. PROC (s_sys_getgrgid, "%getgrgid", 0, 1, 0, scm_sys_getgrgid);
  376. #ifdef __STDC__
  377. SCM 
  378. scm_sys_getgrgid (SCM name)
  379. #else
  380. SCM 
  381. scm_sys_getgrgid (name)
  382.      SCM name;
  383. #endif
  384. {
  385.   SCM result;
  386.   struct group *entry;
  387.   SCM *ve;
  388.   result = scm_make_vector (MAKINUM (4), UNSPECIFIED);
  389.   ve = VELTS (result);
  390.   DEFER_INTS;
  391.   if (UNBNDP (name) || (name == BOOL_F))
  392.     SYSCALL (entry = getgrent ());
  393.   else if (INUMP (name))
  394.     SYSCALL (entry = getgrgid (INUM (name)));
  395.   else
  396.     {
  397.       ASSERT (NIMP (name) && STRINGP (name), name, ARG1, s_sys_getgrgid);
  398.       SYSCALL (entry = getgrnam (CHARS (name)));
  399.     }
  400.   ALLOW_INTS;
  401.   if (!entry)
  402.     return BOOL_F;
  403.   ve[0] = makfrom0str (entry->gr_name);
  404.   ve[1] = makfrom0str (entry->gr_passwd);
  405.   ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
  406.   ve[3] = scm_makfromstrs (-1, entry->gr_mem);
  407.   return result;
  408. }
  409.  
  410.  
  411. PROC (s_setgrent, "setgrent", 0, 1, 0, scm_setgrent);
  412. #ifdef __STDC__
  413. SCM 
  414. scm_setgrent (SCM arg)
  415. #else
  416. SCM 
  417. scm_setgrent (arg)
  418.      SCM arg;
  419. #endif
  420. {
  421.   if (UNBNDP (arg) || FALSEP (arg))
  422.     endgrent ();
  423.   else
  424.     setgrent ();
  425.   return UNSPECIFIED;
  426. }
  427.  
  428. PROC (s_sys_kill, "%kill", 2, 0, 0, scm_sys_kill);
  429. #ifdef __STDC__
  430. SCM 
  431. scm_sys_kill (SCM pid, SCM sig)
  432. #else
  433. SCM 
  434. scm_sys_kill (pid, sig)
  435.      SCM pid;
  436.      SCM sig;
  437. #endif
  438. {
  439.   int i;
  440.   ASSERT (INUMP (pid), pid, ARG1, s_sys_kill);
  441.   ASSERT (INUMP (sig), sig, ARG2, s_sys_kill);
  442.   /* Signal values are interned in scm_init_posix().  */
  443.   SYSCALL (i = kill ((int) INUM (pid), (int) INUM (sig)));
  444.   return i ? BOOL_F : BOOL_T;
  445. }
  446.  
  447.  
  448. PROC (s_sys_waitpid, "%waitpid", 1, 1, 0, scm_sys_waitpid);
  449. #ifdef __STDC__
  450. SCM 
  451. scm_sys_waitpid (SCM pid, SCM options)
  452. #else
  453. SCM 
  454. scm_sys_waitpid (pid, options)
  455.      SCM pid;
  456.      SCM options;
  457. #endif
  458. {
  459.   int i;
  460.   int status;
  461.   int ioptions;
  462.   ASSERT (INUMP (pid), pid, ARG1, s_sys_waitpid);
  463.   if (UNBNDP (options))
  464.     ioptions = 0;
  465.   else
  466.     {
  467.       ASSERT (INUMP (options), options, ARG2, s_sys_waitpid);
  468.       /* Flags are interned in scm_init_posix.  */
  469.       ioptions = INUM (options);
  470.     }
  471.   SYSCALL (i = waitpid (INUM (pid), &status, ioptions));
  472.   return ((i == -1)
  473.       ? BOOL_F
  474.       : scm_cons (MAKINUM (0L + i), MAKINUM (0L + status)));
  475. }
  476.  
  477.  
  478. PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
  479. #ifdef __STDC__
  480. SCM 
  481. scm_getppid (void)
  482. #else
  483. SCM 
  484. scm_getppid ()
  485. #endif
  486. {
  487.   return MAKINUM (0L + getppid ());
  488. }
  489.  
  490. PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
  491. #ifdef __STDC__
  492. SCM 
  493. scm_getuid (void)
  494. #else
  495. SCM 
  496. scm_getuid ()
  497. #endif
  498. {
  499.   return MAKINUM (0L + getuid ());
  500. }
  501.  
  502. PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
  503. #ifdef __STDC__
  504. SCM 
  505. scm_getgid (void)
  506. #else
  507. SCM 
  508. scm_getgid ()
  509. #endif
  510. {
  511.   return MAKINUM (0L + getgid ());
  512. }
  513.  
  514. #ifndef LACK_E_IDs
  515. PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
  516. #ifdef __STDC__
  517. SCM 
  518. scm_geteuid (void)
  519. #else
  520. SCM 
  521. scm_geteuid ()
  522. #endif
  523. {
  524.   return MAKINUM (0L + geteuid ());
  525. }
  526.  
  527. PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
  528. #ifdef __STDC__
  529. SCM 
  530. scm_getegid (void)
  531. #else
  532. SCM 
  533. scm_getegid ()
  534. #endif
  535. {
  536.   return MAKINUM (0L + getegid ());
  537. }
  538. #endif
  539.  
  540.  
  541. PROC (s_sys_setuid, "%setuid", 1, 0, 0, scm_sys_setuid);
  542. #ifdef __STDC__
  543. SCM 
  544. scm_sys_setuid (SCM id)
  545. #else
  546. SCM 
  547. scm_sys_setuid (id)
  548.      SCM id;
  549. #endif
  550. {
  551.   ASSERT (INUMP (id), id, ARG1, s_sys_setuid);
  552.   return setuid (INUM (id)) ? BOOL_F : BOOL_T;
  553. }
  554.  
  555. PROC (s_sys_setgid, "%setgid", 1, 0, 0, scm_sys_setgid);
  556. #ifdef __STDC__
  557. SCM 
  558. scm_sys_setgid (SCM id)
  559. #else
  560. SCM 
  561. scm_sys_setgid (id)
  562.      SCM id;
  563. #endif
  564. {
  565.   ASSERT (INUMP (id), id, ARG1, s_sys_setgid);
  566.   return setgid (INUM (id)) ? BOOL_F : BOOL_T;
  567. }
  568.  
  569. #ifndef LACK_E_IDs
  570. PROC (s_sys_seteuid, "%seteuid", 1, 0, 0, scm_sys_seteuid);
  571. #ifdef __STDC__
  572. SCM 
  573. scm_sys_seteuid (SCM id)
  574. #else
  575. SCM 
  576. scm_sys_seteuid (id)
  577.      SCM id;
  578. #endif
  579. {
  580.   ASSERT (INUMP (id), id, ARG1, s_sys_seteuid);
  581.   return seteuid (INUM (id)) ? BOOL_F : BOOL_T;
  582. }
  583.  
  584. PROC (s_sys_setegid, "%setegid", 1, 0, 0, scm_sys_setegid);
  585. #ifdef __STDC__
  586. SCM 
  587. scm_sys_setegid (SCM id)
  588. #else
  589. SCM 
  590. scm_sys_setegid (id)
  591.      SCM id;
  592. #endif
  593. {
  594.   ASSERT (INUMP (id), id, ARG1, s_sys_setegid);
  595.   return setegid (INUM (id)) ? BOOL_F : BOOL_T;
  596. }
  597. #endif
  598.  
  599. #ifndef ttyname
  600. extern char * ttyname();
  601. #endif
  602.  
  603. PROC (s_ttyname, "ttyname", 1, 0, 0, scm_ttyname);
  604. #ifdef __STDC__
  605. SCM 
  606. scm_ttyname (SCM port)
  607. #else
  608. SCM 
  609. scm_ttyname (port)
  610.      SCM port;
  611. #endif
  612. {
  613.   char *ans;
  614.   int fd;
  615.   ASSERT (NIMP (port) && OPPORTP (port), port, ARG1, s_ttyname);
  616.   if (tc16_fport != TYP16 (port))
  617.     return BOOL_F;
  618.   fd = fileno (STREAM (port));
  619.   if (fd != -1)
  620.     SYSCALL (ans = ttyname (fd));
  621.   /* ans could be overwritten by another call to ttyname */
  622.   return (((fd != -1) && ans)
  623.       ? makfrom0str (ans)
  624.       : BOOL_F);
  625. }
  626.  
  627.  
  628. /* Copy exec args from an SCM vector into a new C array.  */
  629. #ifdef __STDC__
  630. static char **
  631. scm_convert_exec_args (SCM args)
  632. #else
  633. static char **
  634. scm_convert_exec_args (args)
  635.      SCM args;
  636. #endif
  637. {
  638.   char **execargv;
  639.   int num_args;
  640.   int i;
  641.   DEFER_INTS;
  642.   num_args = scm_ilength (args);
  643.   execargv = (char **) 
  644.     scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
  645.   for (i = 0; NNULLP (args); args = CDR (args), ++i)
  646.     {
  647.       sizet len;
  648.       char *dst;
  649.       char *src;
  650.       ASSERT (NIMP (CAR (args)) && STRINGP (CAR (args)), CAR (args),
  651.           "wrong type in ARG", "exec arg");
  652.       len = 1 + LENGTH (CAR (args));
  653.       dst = (char *) scm_must_malloc ((long) len, s_ttyname);
  654.       src = CHARS (CAR (args));
  655.       while (len--) 
  656.     dst[len] = src[len];
  657.       execargv[i] = dst;
  658.     }
  659.   execargv[i] = 0;
  660.   ALLOW_INTS;
  661.   return execargv;
  662. }
  663.  
  664. PROC (s_sys_execl, "%execl", 0, 0, 1, scm_sys_execl);
  665. #ifdef __STDC__
  666. SCM
  667. scm_sys_execl (SCM args)
  668. #else
  669. SCM
  670. scm_sys_execl (args)
  671.      SCM args;
  672. #endif
  673. {
  674.   char **execargv;
  675.   SCM filename = CAR (args);
  676.   ASSERT (NIMP (filename) && STRINGP (filename), filename, ARG1, s_sys_execl);
  677.   args = CDR (args);
  678.   execargv = scm_convert_exec_args (args);
  679.   execv (CHARS (filename), execargv);
  680.   return BOOL_F;
  681. }
  682.  
  683. PROC (s_sys_execlp, "%execlp", 0, 0, 1, scm_sys_execlp);
  684. #ifdef __STDC__
  685. SCM
  686. scm_sys_execlp (SCM args)
  687. #else
  688. SCM
  689. scm_sys_execlp (args)
  690.      SCM args;
  691. #endif
  692. {
  693.   char **execargv;
  694.   SCM filename = CAR (args);
  695.   ASSERT (NIMP (filename) && STRINGP (filename), filename, ARG1, s_sys_execlp);
  696.   args = CDR (args);
  697.   execargv = scm_convert_exec_args (args);
  698.   execvp (CHARS (filename), execargv);
  699.   return BOOL_F;
  700. }
  701.  
  702. /* Flushing streams etc., is not done here.  */
  703. PROC (s_sys_fork, "%fork", 0, 0, 0, scm_sys_fork);
  704. #ifdef __STDC__
  705. SCM
  706. scm_sys_fork(void)
  707. #else
  708. SCM
  709. scm_sys_fork()
  710. #endif
  711. {
  712.   pid_t pid;
  713.   pid = fork ();
  714.   if (pid == -1)
  715.     return BOOL_F;
  716.   else
  717.     return MAKINUM (0L+pid);
  718. }
  719.  
  720.  
  721.  
  722.  
  723. #ifdef __STDC__
  724. void
  725. fill_select_type (SELECT_TYPE * set, SCM list)
  726. #else
  727. void
  728. fill_select_type (set, list)
  729.      SELECT_TYPE * set;
  730.      SCM list;
  731. #endif
  732. {
  733.   while (list != EOL)
  734.     {
  735.       if (   NIMP (CAR (list))
  736.       && (tc16_fport == TYP16 (CAR (list)))
  737.       && OPPORTP (CAR (list)))
  738.     FD_SET (fileno (STREAM (CAR (list))), set);
  739.       else if (INUMP (CAR (list)))
  740.     FD_SET (INUM (CAR (list)), set);
  741.       list = CDR (list);
  742.     }
  743. }
  744.  
  745. #ifdef __STDC__
  746. SCM 
  747. retrieve_select_type (SELECT_TYPE * set, SCM list)
  748. #else
  749. SCM 
  750. retrieve_select_type (set, list)
  751.      SELECT_TYPE * set;
  752.      SCM list;
  753. #endif
  754. {
  755.   SCM answer;
  756.   answer = EOL;
  757.   while (list != EOL)
  758.     {
  759.       if (   NIMP (CAR (list))
  760.       && (tc16_fport == TYP16 (CAR (list)))
  761.       && OPPORTP (CAR (list)))
  762.     {
  763.       if (FD_ISSET (fileno (STREAM (CAR (list))), set))
  764.         answer = scm_cons (CAR (list), answer);
  765.     }
  766.       else if (INUMP (CAR (list)))
  767.     {
  768.       if (FD_ISSET (INUM (CAR (list)), set))
  769.         answer = scm_cons (CAR (list), answer);
  770.     }
  771.       list = CDR (list);
  772.     }
  773.   return answer;
  774. }
  775.  
  776.  
  777. PROC (s_sys_select, "%select", 5, 0, 0, scm_sys_select);
  778. #ifdef __STDC__
  779. SCM
  780. scm_sys_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)
  781. #else
  782. SCM
  783. scm_sys_select (reads, writes, excepts, secs, msecs)
  784.      SCM reads;
  785.      SCM writes;
  786.      SCM excepts;
  787.      SCM secs;
  788.      SCM msecs;
  789. #endif
  790. {
  791. #ifdef HAVE_SELECT
  792.   int ret;
  793.   struct timeval timeout;
  794.   struct timeval * time_p;
  795.   SELECT_TYPE read_set;
  796.   SELECT_TYPE write_set;
  797.   SELECT_TYPE except_set;
  798.   SCM answer;
  799.   int sreturn;
  800.  
  801.   ASSERT (-1 < scm_ilength (reads), reads, ARG1, s_sys_select);
  802.   ASSERT (-1 < scm_ilength (writes), reads, ARG1, s_sys_select);
  803.   ASSERT (-1 < scm_ilength (excepts), reads, ARG1, s_sys_select);
  804.   ASSERT (INUMP (secs), secs, ARG4, s_sys_select);
  805.   ASSERT (INUMP (msecs), msecs, ARG5, s_sys_select);
  806.  
  807.   FD_ZERO (&read_set);
  808.   FD_ZERO (&write_set);
  809.   FD_ZERO (&except_set);
  810.  
  811.   fill_select_type (&read_set, reads);
  812.   fill_select_type (&write_set, writes);
  813.   fill_select_type (&except_set, excepts);
  814.  
  815.   if (INUM (secs) || INUM (msecs))
  816.     {
  817.       timeout.tv_sec = INUM (secs);
  818.       timeout.tv_usec = 1000 * INUM (msecs);
  819.       time_p = &timeout;
  820.     }
  821.   else
  822.     time_p = 0;
  823.  
  824.   DEFER_INTS;
  825.   sreturn = select (SELECT_SET_SIZE,
  826.             &read_set, &write_set, &except_set, time_p);
  827.   ALLOW_INTS;
  828.   if (sreturn < 0)
  829.     return MAKINUM (sreturn);
  830.   else
  831.     return scm_listify (retrieve_select_type (&read_set, reads),
  832.             retrieve_select_type (&write_set, writes),
  833.             retrieve_select_type (&except_set, excepts),
  834.             SCM_UNDEFINED);
  835. #else
  836.   return BOOL_F;
  837. #endif
  838. }
  839.  
  840.  
  841. PROC (s_sys_uname, "%uname", 0, 0, 0, scm_sys_uname);
  842. #ifdef __STDC__
  843. SCM 
  844. scm_sys_uname (void)
  845. #else
  846. SCM 
  847. scm_sys_uname ()
  848. #endif
  849. {
  850. #ifdef HAVE_UNAME
  851.   struct utsname buf;
  852.   SCM ans = scm_make_vector(MAKINUM(5), UNSPECIFIED);
  853.   SCM *ve = VELTS (ans);
  854.   if (uname (&buf))
  855.     return BOOL_F;
  856.   ve[0] = makfrom0str (buf.sysname);
  857.   ve[1] = makfrom0str (buf.nodename);
  858.   ve[2] = makfrom0str (buf.release);
  859.   ve[3] = makfrom0str (buf.version);
  860.   ve[4] = makfrom0str (buf.machine);
  861. /* 
  862.   FIXME
  863.   ve[5] = makfrom0str (buf.domainname);
  864. */
  865.   return ans;
  866. #else
  867.   return BOOL_F;
  868. #endif
  869. }
  870.  
  871. extern char ** environ;
  872. PROC (s_environ, "environ", 0, 1, 0, scm_environ);
  873. #ifdef __STDC__
  874. SCM
  875. scm_environ (SCM env)
  876. #else
  877. SCM
  878. scm_environ (env)
  879.      SCM env;
  880. #endif
  881. {
  882.   if (UNBNDP (env))
  883.     return scm_makfromstrs (-1, environ);
  884.   else
  885.     {
  886.       int num_strings;
  887.       char **new_environ;
  888.       int i = 0;
  889.       ASSERT (NIMP (env) && CONSP (env), env, ARG1, s_environ);
  890.       num_strings = scm_ilength (env);
  891.       new_environ = (char **) scm_must_malloc ((num_strings + 1)
  892.                            * sizeof (char *),
  893.                            s_environ);
  894.       while (NNULLP (env))
  895.     {
  896.       int len;
  897.       char *src;
  898.       ASSERT (NIMP (CAR (env)) && STRINGP (CAR (env)), env, ARG1,
  899.           s_environ);
  900.       len = 1 + LENGTH (CAR (env));
  901.       new_environ[i] = scm_must_malloc ((long) len, s_environ);
  902.       src = CHARS (CAR (env));
  903.       while (len--) 
  904.         new_environ[i][len] = src[len];
  905.       env = CDR (env);
  906.       i++;
  907.     }
  908.       new_environ[i] = 0;
  909.       /* Free the old environment, except when called for the first
  910.        * time.
  911.        */
  912.       {
  913.     char **ep;
  914.     static int first = 1;
  915.     if (!first)
  916.       {
  917.         for (ep = environ; *ep != NULL; ep++)
  918.           scm_must_free (*ep);
  919.         scm_must_free ((char *) environ);
  920.       }
  921.     first = 0;
  922.       }
  923.       environ = new_environ;
  924.       return UNSPECIFIED;
  925.     }
  926. }
  927.  
  928.  
  929. #ifdef __STDC__
  930. void 
  931. scm_init_posix (void)
  932. #else
  933. void 
  934. scm_init_posix ()
  935. #endif
  936. {
  937.   scm_add_feature ("posix");
  938. #ifdef WAIT_ANY
  939.   scm_sysintern ("WAIT_ANY", MAKINUM (WAIT_ANY));
  940. #endif
  941. #ifdef WAIT_MYPGRP
  942.   scm_sysintern ("WAIT_MYPGRP", MAKINUM (WAIT_MYPGRP));
  943. #endif
  944. #ifdef WNOHANG
  945.   scm_sysintern ("WNOHANG", MAKINUM (WNOHANG));
  946. #endif
  947. #ifdef WUNTRACED
  948.   scm_sysintern ("WUNTRACED", MAKINUM (WUNTRACED));
  949. #endif
  950. #ifdef SIGHUP
  951.   scm_sysintern ("SIGHUP", MAKINUM (SIGHUP));
  952. #endif
  953. #ifdef SIGINT
  954.   scm_sysintern ("SIGINT", MAKINUM (SIGINT));
  955. #endif
  956. #ifdef SIGQUIT
  957.   scm_sysintern ("SIGQUIT", MAKINUM (SIGQUIT));
  958. #endif
  959. #ifdef SIGILL
  960.   scm_sysintern ("SIGILL", MAKINUM (SIGILL));
  961. #endif
  962. #ifdef SIGTRAP
  963.   scm_sysintern ("SIGTRAP", MAKINUM (SIGTRAP));
  964. #endif
  965. #ifdef SIGABRT
  966.   scm_sysintern ("SIGABRT", MAKINUM (SIGABRT));
  967. #endif
  968. #ifdef SIGIOT
  969.   scm_sysintern ("SIGIOT", MAKINUM (SIGIOT));
  970. #endif
  971. #ifdef SIGBUS
  972.   scm_sysintern ("SIGBUS", MAKINUM (SIGBUS));
  973. #endif
  974. #ifdef SIGFPE
  975.   scm_sysintern ("SIGFPE", MAKINUM (SIGFPE));
  976. #endif
  977. #ifdef SIGKILL
  978.   scm_sysintern ("SIGKILL", MAKINUM (SIGKILL));
  979. #endif
  980. #ifdef SIGUSR1
  981.   scm_sysintern ("SIGUSR1", MAKINUM (SIGUSR1));
  982. #endif
  983. #ifdef SIGSEGV
  984.   scm_sysintern ("SIGSEGV", MAKINUM (SIGSEGV));
  985. #endif
  986. #ifdef SIGUSR2
  987.   scm_sysintern ("SIGUSR2", MAKINUM (SIGUSR2));
  988. #endif
  989. #ifdef SIGPIPE
  990.   scm_sysintern ("SIGPIPE", MAKINUM (SIGPIPE));
  991. #endif
  992. #ifdef SIGALRM
  993.   scm_sysintern ("SIGALRM", MAKINUM (SIGALRM));
  994. #endif
  995. #ifdef SIGTERM
  996.   scm_sysintern ("SIGTERM", MAKINUM (SIGTERM));
  997. #endif
  998. #ifdef SIGSTKFLT
  999.   scm_sysintern ("SIGSTKFLT", MAKINUM (SIGSTKFLT));
  1000. #endif
  1001. #ifdef SIGCHLD
  1002.   scm_sysintern ("SIGCHLD", MAKINUM (SIGCHLD));
  1003. #endif
  1004. #ifdef SIGCONT
  1005.   scm_sysintern ("SIGCONT", MAKINUM (SIGCONT));
  1006. #endif
  1007. #ifdef SIGSTOP
  1008.   scm_sysintern ("SIGSTOP", MAKINUM (SIGSTOP));
  1009. #endif
  1010. #ifdef SIGTSTP
  1011.   scm_sysintern ("SIGTSTP", MAKINUM (SIGTSTP));
  1012. #endif
  1013. #ifdef SIGTTIN
  1014.   scm_sysintern ("SIGTTIN", MAKINUM (SIGTTIN));
  1015. #endif
  1016. #ifdef SIGTTOU
  1017.   scm_sysintern ("SIGTTOU", MAKINUM (SIGTTOU));
  1018. #endif
  1019. #ifdef SIGIO
  1020.   scm_sysintern ("SIGIO", MAKINUM (SIGIO));
  1021. #endif
  1022. #ifdef SIGPOLL
  1023.   scm_sysintern ("SIGPOLL", MAKINUM (SIGPOLL));
  1024. #endif
  1025. #ifdef SIGURG
  1026.   scm_sysintern ("SIGURG", MAKINUM (SIGURG));
  1027. #endif
  1028. #ifdef SIGXCPU
  1029.   scm_sysintern ("SIGXCPU", MAKINUM (SIGXCPU));
  1030. #endif
  1031. #ifdef SIGXFSZ
  1032.   scm_sysintern ("SIGXFSZ", MAKINUM (SIGXFSZ));
  1033. #endif
  1034. #ifdef SIGVTALRM
  1035.   scm_sysintern ("SIGVTALRM", MAKINUM (SIGVTALRM));
  1036. #endif
  1037. #ifdef SIGPROF
  1038.   scm_sysintern ("SIGPROF", MAKINUM (SIGPROF));
  1039. #endif
  1040. #ifdef SIGWINCH
  1041.   scm_sysintern ("SIGWINCH", MAKINUM (SIGWINCH));
  1042. #endif
  1043. #ifdef SIGLOST
  1044.   scm_sysintern ("SIGLOST", MAKINUM (SIGLOST));
  1045. #endif
  1046. #ifdef SIGPWR
  1047.   scm_sysintern ("SIGPWR", MAKINUM (SIGPWR));
  1048. #endif
  1049. #include "posix.x"
  1050. }
  1051.